Detecciones con cámara trampa y avístamientos incidentales
| Kavanayen | Warapata | |
|---|---|---|
| Nr. bloques | 4 | 6 |
| Nr. celdas | 51 | 72 |
| Nr. celdas muestreadas | 40 | 72 |
| Nr. celdas con cámaras | 14 | 57 |
| Días*cámara | 703 | 4548 |
| Nr. celdas visitadas | 39 | 59 |
| Distancia recorrida (km) | 119.49 [km] | 218.14 [km] |
Error : The fig.showtext code chunk option must be TRUE
R version 4.2.2 (2022-10-31)
Platform: x86_64-solus-linux-gnu (64-bit)
Running under: Solus 4.4 Harmony
Matrix products: default
BLAS: /usr/lib64/haswell/libopenblas_haswellp-r0.3.20.so
LAPACK: /usr/lib64/R/lib/libRlapack.so
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] RColorBrewer_1.1-3 tmap_3.3-3 chron_2.3-61
[4] raster_3.6-20 tidyr_1.3.0 units_0.8-2
[7] htmltools_0.5.5 DT_0.28 ggplot2_3.4.2
[10] sp_1.6-0 leaflet_2.1.2 dplyr_1.1.2
[13] flexdashboard_0.6.2
loaded via a namespace (and not attached):
[1] sass_0.4.5 jsonlite_1.8.4 viridisLite_0.4.2
[4] here_1.0.1 bslib_0.4.2 highr_0.10
[7] yaml_2.3.7 pillar_1.9.0 lattice_0.21-8
[10] glue_1.6.2 digest_0.6.31 colorspace_2.1-0
[13] thematic_0.1.3 leaflet.providers_1.9.0 XML_3.99-0.14
[16] pkgconfig_2.0.3 stars_0.6-2 s2_1.1.3
[19] purrr_1.0.1 scales_1.2.1 fontawesome_0.5.1
[22] terra_1.7-29 tibble_3.2.1 proxy_0.4-27
[25] generics_0.1.3 farver_2.1.1 ellipsis_0.3.2
[28] cachem_1.0.8 withr_2.5.0 leafsync_0.1.0
[31] cli_3.6.1 magrittr_2.0.3 memoise_2.0.1
[34] evaluate_0.20 fs_1.6.2 fansi_1.0.4
[37] lwgeom_0.2-13 class_7.3-22 textshaping_0.3.6
[40] tools_4.2.2 lifecycle_1.0.3 munsell_0.5.0
[43] compiler_4.2.2 jquerylib_0.1.4 e1071_1.7-13
[46] systemfonts_1.0.4 rlang_1.1.1 classInt_0.4-9
[49] grid_4.2.2 tmaptools_3.1-1 dichromat_2.0-0.1
[52] rstudioapi_0.14 htmlwidgets_1.6.2 crosstalk_1.2.0
[55] labeling_0.4.2 leafem_0.2.0 base64enc_0.1-3
[58] rmarkdown_2.21 wk_0.7.2 gtable_0.3.3
[61] codetools_0.2-19 curl_5.0.0 abind_1.4-5
[64] DBI_1.1.3 R6_2.5.1 rgdal_1.6-7
[67] knitr_1.42 fastmap_1.1.1 utf8_1.2.3
[70] rprojroot_2.0.3 ragg_1.2.5 KernSmooth_2.23-21
[73] parallel_4.2.2 Rcpp_1.0.10 vctrs_0.6.2
[76] sf_1.0-12 png_0.1-8 tidyselect_1.2.0
[79] xfun_0.39
---
title: "Monitoreo de Mamíferos y otros vertebrados en la Gran Sabana"
output:
flexdashboard::flex_dashboard:
theme:
version: 4
bg: "#F1FBFB"
fg: "#5B1A18"
primary: "#D67236"
navbar-bg: "#FD6467"
base_font:
google: Prompt
heading_font:
google: Sen
code_font:
google:
# arguments to sass::font_google()
family: JetBrains Mono
local: false
social: menu
source: embed
navbar:
- { title: "Proyecto en OSF", href: "https://osf.io/6qtep/", align: left }
- { title: "Repositorio GitHub", href: "https://github.com/jrfep/GS-svocc", align: left }
editor_options:
chunk_output_type: console
---
```{r setup, include=FALSE}
library(flexdashboard)
library(dplyr)
library(leaflet)
library(sp)
library(ggplot2)
library(DT)
library(htmltools)
library(units)
#library(plotly)
#library(spocc)
#library(rinat)
#library(mapr)
require(tidyr)
require(raster)
require(chron)
#library(sf)
library(tmap)
#library(lubridate)
#library(calendR)
library(RColorBrewer)
palette(brewer.pal(8, "Set2"))
```
```{r thematic, include = FALSE}
thematic::thematic_rmd(font = "auto")
```
```{r dataread, message=FALSE, warning=FALSE, include=FALSE}
here::i_am("doc/dashboard.Rmd")
GIS.data <- here::here("Rdata","GIS.rda")
if (!file.exists(GIS.data))
download.file(url="https://figshare.com/ndownloader/files/37547995",destfile=GIS.data)
load(GIS.data)
event.data <- here::here("Rdata","all-events.csv")
if (!file.exists(event.data))
download.file(url="https://figshare.com/ndownloader/files/42055824",destfile=event.data)
eventos_actualizados <- read.csv2(event.data)
coordinates(eventos_actualizados) <- c("long","lat")
crs(eventos_actualizados) <- grd@proj4string
qry <- over(eventos_actualizados,grd)
eventos_actualizados$grid <- qry$OID_
## differences between both event data frames:
eventos_adicionales <- eventos %>% filter(!species %in% eventos_actualizados$species) %>%
mutate(fotos=as.character(fotos))
eventos <- eventos_actualizados@data %>%
bind_rows(eventos_adicionales)
cam <- camaras %>%
group_by(grid) %>%
summarise(cam = sum(dias.de.trabajo),
caz = max(caza.celda)) %>%
transmute(grid, caz, cam)
tps_xy <- spTransform(tps, CRS("+proj=utm +zone=19 +datum=WGS84 +units=m +no_defs +type=crs"))
xys <- coordinates(tps_xy)
walk <- tps@data %>%
group_by(grid) %>%
summarise(walk = n(),
dates = n_distinct(time))
walk_ms <- data.frame()
for (k in unique(tps_xy@data$grid)) {
ss <- tps_xy@data$grid == k
mtz <- as.matrix(dist(xys[ss,]))
mtz[upper.tri(mtz,diag = TRUE)] <- NA
walk_ms <- rbind(walk_ms, data.frame(grid=k, dist_walk=sum(apply(mtz[-1,],1, min, na.rm=TRUE))))
}
walk <- walk %>% left_join(walk_ms, by = "grid") %>%
mutate(region = if_else(grid <151, "Warapata", "Kavanayen"))
gpslog <- spLines(subset(tps,tps@data$track_fid ==0),
subset(tps,tps@data$track_fid ==1),
subset(tps,tps@data$track_fid ==2),
subset(tps,tps@data$track_fid ==3),
subset(tps,tps@data$track_fid ==5),
subset(tps,tps@data$track_fid ==6),
subset(tps,tps@data$track_fid ==7),
subset(tps,tps@data$track_fid ==10),
subset(tps,tps@data$track_fid ==11),
subset(tps,tps@data$track_fid ==12),
subset(tps,tps@data$track_fid ==13),
subset(tps,tps@data$track_fid ==14),
subset(tps,tps@data$track_fid ==15),
subset(tps,tps@data$track_fid ==16),
subset(tps,tps@data$track_fid ==17),
attr=data.frame(fid=0:14))
event_summary <- eventos %>%
group_by(grid) %>%
summarise(
total_spp=n_distinct(species))
on_camera_event_summary <- eventos %>%
filter(!camara %in% "RAS") %>%
group_by(grid) %>%
summarise(
on_camera_spp=n_distinct(species),
on_camera_events=n())
off_camera_event_summary <- eventos %>%
filter(camara %in% "RAS") %>%
group_by(grid) %>%
summarise(
off_camera_spp=n_distinct(species),
off_camera_events=n())
event_summary <- event_summary %>%
left_join(on_camera_event_summary, by = "grid") %>%
left_join(off_camera_event_summary, by = "grid")
effort_data <- walk %>%
full_join(cam, by = "grid") %>%
full_join(event_summary, by = "grid") %>%
filter(!is.na(grid) ) %>%
transmute(grid,
walk=coalesce(walk,0L),
dist_walk=coalesce(dist_walk,0L),
cam=coalesce(cam,0L),
total_spp=coalesce(total_spp,0L),
on_camera_spp=coalesce(on_camera_spp,0L),
off_camera_spp=coalesce(off_camera_spp,0L),
on_camera_events=coalesce(on_camera_events,0L),
off_camera_events=coalesce(off_camera_events,0L))
effort_data$bloque <- factor(grd@data$cuadrado[match(effort_data$grid,grd@data$OID_)])
grd@data <- grd@data %>%
left_join(event_summary, by=c("OID_"="grid")) %>%
transmute(Celda=OID_,
Bloque=cuadrado,
#`Distancia recorrida` = dist_walk,
#`Dias*cámara` = cam,
`Eventos fotográficos` = coalesce(on_camera_events,0L),
`Otros avistamientos` = coalesce(off_camera_events,0L),
`Especies fotografiadas` = coalesce(on_camera_spp,0L),
`Especies avistadas` = coalesce(off_camera_spp,0L),
`Total spp. detectadas` = coalesce(total_spp,0L),
)
```
Column1{.tabset .tabset-fade data-width=250}
-------
Detecciones con cámara trampa y avístamientos incidentales
### Esfuerzo de muestreo {data-width=245}
```{r esfuerzo}
cuadro_2 <- effort_data %>%
mutate(Region = if_else(bloque %in% 1:6,"Warapata","Kavanayen")) %>%
group_by(Region) %>%
summarise(
`Nr. bloques` = n_distinct(bloque),
`Nr. celdas` = n_distinct(grid),
`Nr. celdas muestreadas` = sum(if_else(cam>0 | dist_walk>0,1,0)),
`Nr. celdas con cámaras` = sum(if_else(cam>0,1,0)),
`Días*cámara`=sum(cam),
`Nr. celdas visitadas` = sum(if_else(dist_walk>0,1,0)),
`Distancia recorrida (km)` = sum(set_units(dist_walk,'m')) %>% set_units('km') %>% round(2),
.groups = "keep") %>% t()
colnames(cuadro_2) <- cuadro_2[1,]
cuadro_2[-1,] %>% knitr::kable()
```
### Observaciones por especie {data-width=245}
```{r taxalist}
###Create HTML formatting code for header and overall table HTML container
#create header style HTML code
# use colors from the flatly theme?
header.style <- "th { font-family: 'Arial'; font-weight: bold; color: white; background-color: #18bc9c;}"
cell.style <- "text-align: center; border-right-width: 1px; border-right-style: solid; border-right-color: white;
border-bottom-width: 1px; border-bottom-style: solid; border-bottom-color: white"
hcell.style <- "text-align: center; border-width: 1px; border-style: solid; border-color: white; font-size:8px; ba
ckground-color: #18bc9c;"
#pull header names from the table
header.names <- c("Assessment Unit", "Period", "min(RS[i])", "mean RS", "max(RS[i])", "mean RS")
# The container parameter allows us to design the header of the table using CSS
my.container <- withTags(table(
style(type = "text/css", header.style),
thead(
tr(th("",colspan=2),
th("Original formula",colspan=3, style = hcell.style),
th("Conditional formula", style = hcell.style)),
tr(
lapply(header.names, th, style = cell.style)
)
)
)
)
cuadro_1 <- eventos %>% group_by(Especie = species) %>% summarise(`Eventos fotográficos` = sum(!camara %in% "RAS"),`Otros avistamientos`=sum(camara %in% "RAS"))
DT::datatable(
cuadro_1,
#colnames = ,
#caption = tbl_caption,
options = list(
dom = 't',
pageLength = -1,
order = list(list(1, 'desc'),list(2, 'desc'))),
#container=my.container,
rownames = FALSE,
width = '100%',
height = '100%') #%>%
# formatRound(c("min_RS", "mean_RS", "max_RS", "mean_RS_cor"),digits=3)
```
Column2 {.tabset .tabset-fade}
-------
### Mapa
```{r map, eval = TRUE}
tmap_mode("view")
map1 <-
tm_shape(gpslog, name = "Recorrido (GPS)") +
tm_lines(col = "maroon") +
tm_shape(subset(grd,Bloque %in% 1:6), name = "Warapata: Unidades de muestreo") +
tm_polygons( border.col = "#F1BB7B", alpha=.5) +
tm_shape(subset(grd,Bloque %in% 7:10), name = "Kavanayen: Unidades de muestreo") +
tm_polygons( border.col = "#FD6467", alpha=.5) +
tm_minimap()
tmap_leaflet(map1)
```
### Caminata {data-width=245}
```{r "walking distance", fig.showtext = TRUE}
ggplot(data=walk, aes(x = walk, y = dist_walk, colour = region)) +
geom_point() +
scale_colour_manual(values=c("Kavanayen"="#FD6467","Warapata"="#F1BB7B")) +
labs(x="GPS log points", y = "Distancia (metros)", title = "Distancia recorrida en cada unidad de muestreo (celda)")
```
### Rastros y otros avistamientos {data-width=245}
```{r xtraKavanayen}
filter(eventos, camara %in% "RAS") %>%
transmute(Especie=species, `Tipo de evidencia`=evento, Bloque=bloque, Celda=grid, Año=ano, Mes=mes,Día=dia) %>%
DT::datatable(options = list(
pageLength = 25,
order = list(list(4, 'asc'),list(5, 'asc'),list(6, 'asc'))),
rownames = FALSE)
```
### Esfuerzo de muestreo (expandido)
```{r obsbyyear}
effort_data %>%
group_by(bloque) %>%
summarise(`nr. de celdas`=n_distinct(grid),
`Puntos del log del GPS` = sum(walk),
`Distancia recorrida (km)` = sum(set_units(dist_walk,'m')) %>% set_units('km'),
`Días cámara` = sum(cam),
`Eventos fotográficos` = sum(on_camera_events),
`Otros avistamientos` = sum(off_camera_events)) %>%
DT::datatable(options = list(
pageLength = 25),
rownames = FALSE) %>%
formatRound(c("Distancia recorrida (km)"),digits=2)
```
### Información sobre la sesión de R
```{r sessionInfo}
sessionInfo()
```
Column3{data-width=150}
-------
### Warapata
### Eventos fotográficos
```{r}
on_camera <- effort_data %>% filter(bloque %in% 1:6) %>% summarise(sum(on_camera_events)) %>% pull
off_camera <- effort_data %>% filter(bloque %in% 1:6) %>% summarise(sum(off_camera_events)) %>% pull
n_especies <- eventos %>% filter(bloque %in% sprintf("B%02d",1:6)) %>% summarise(n_distinct(species)) %>% pull
valueBox(on_camera, icon = "fa-camera", color = "#F1BB7B")
```
### Otros avistamientos
```{r}
valueBox(off_camera, icon = "fa-binoculars", color = "#F1BB7B")
```
### Especies
```{r}
valueBox(n_especies, icon = "fa-paw", color = "#F1BB7B")
```
### Kavanayen
### Eventos fotográficos
```{r}
on_camera <- effort_data %>% filter(bloque %in% 7:10) %>% summarise(sum(on_camera_events)) %>% pull
off_camera <- effort_data %>% filter(bloque %in% 7:10) %>% summarise(sum(off_camera_events)) %>% pull
n_especies <- eventos %>% filter(bloque %in% sprintf("B%02d",7:10)) %>% summarise(n_distinct(species)) %>% pull
valueBox(on_camera, icon = "fa-camera", color = "#FD6467")
```
### Otros avistamientos
```{r}
valueBox(off_camera, icon = "fa-binoculars", color = "#FD6467")
```
### Especies
```{r}
valueBox(n_especies, icon = "fa-paw", color = "#FD6467")
```